00010	C  SUBRS.  SLUR, (JUGGLE), (LOOP), PLTSRT, (LINES), (HOMER),
00110	C  (PLACE), (FINDIT), SCL, FORMAT
06300	
06500		SUBROUTINE SLUR
06600		IMPLICIT INTEGER(A-Q,T-Z)
06610		COMMON/SLR/ SLURX(72)
06700		REAL CENTR
06710		COMMON /XRN/RN(4000) /PLTR/PLT,RHT,RDIS
06900		COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RB,
06950		1 K,KQ,TWICE,RST7,RX,RXX,RTILT,RC,RZ,RW,J3,J4,
06962		1 J5,J6,J7,J8,J9,J10,J11,JQ(8),RJ
07000		COMMON/PTR/PWDS(250),ITEM,L,I,IX /STF/RSTFAC(-3/4),RSJT2
07010		COMMON/ALF/INP,SLURY(72) 
07400	CF	DATA RZZ/2.8/
07500	C  DEFAULT VALUE OF SLUR CURVE FACTOR IS 2.8	
07600	
07805		IF(JA.NE.12)GO TO 2
07810	CF	RA=5.96*RSJT2*R5
07815	CF	L=3
07817	CF	J8=J8*RDIS
07820	CF	IF(J7.LE.J6)J7=J7+360
07822	CF	KQ=6
07823	CF	IF(PLT)KQ=1
07825	CF10	DO 3 K=J6,J7,KQ
07830	CF	R=K
07835	CF	CALL LINES(R3+RA*SIND(R),CENTR+RA*COSD(R),L)
07840	CF3	L=2
07841	CF	J8=J8-1
07842	CF	IF(J8)RETURN
07843	CF	RA=RA+1/RDIS
07845	CF	L=3
07847	CF	GO TO 10
07848	CJA=12  DRAWS CIRCLES. P5=RADIUS, P6=DEGR.1, P7=DEGR.2,P8=THICK(EXPANDS
07849		CALL CIRCLE
07850		RETURN
07880	
07882	C*** SLURS *** 5, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8
07886	C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY
07890	C  P9=NUM IN BRACKET(IF NON-ZERO)
07894	C R7+100=LEFT HALF SLUR, +200=RIGHT HALF, +300=REVERSE DIRECTION.
07900	2	J10=1
07901		J4=-1
07903		J5=3
07905	C  ↑↑↑↑ FOR DPY ONLY (1/3 OF SEGS ARE USED)
07907		TWICE=-1
07930	21	RST7=RSJT2*7.
07960		RQQ=R5-R4
08000		IF(R6.GT.1000)CALL RNOTE(R6)
08010		GO TO (5,6,7),J8+4
08015		GO TO 4
08020	5	R=32
08025	C AFTER DOTTED NOTE
08030		GO TO 8
08040	6	R=22
08045	C BETWEEN NOTES
08050	8	RX=-1.3
08060		GO TO 9
08070	7	R=7
08080		RX=RSJT2
08090	9	CALL RJBX(R)
08100		R6=R6+RX
08250	4	RXX=RHORZ(R6)-R3
08260		RTILT=RQQ*RST7
08270	80	RX=SQRT(RXX**2+RTILT**2)
08272		IF(J8.NE.-1)GO TO 1
08274		IF(RQQ.GT.8)RQQ=8
08276		IF(RQQ.LT.-8)RQQ=-8
08277		RQQ=RQQ*RSTFAC(J2)*1.0
08278		IF(R7)RQQ=-RQQ
08279		R3=R3-RQQ
08280	C  MOVES STEEP SLUR LEFT OR RIGHT IF P8=-1
08290	1	R=CENTR
08300		IF(J8.GT.0)GO TO 180
08310		L=72
08315	C  FOR BRACKETS
08320		RJ=ABS(R7)
08325	C R7+100=LEFT HALF SLUR, +200=RIGHT HALF, +300=REVERSE DIRECTION.
08330		IF(RJ.LT.100)RJ=-1
08335		IF(RJ.GE.300)RJ=0
08400		R7=AMOD(R7,100.0)
08405		CALL SLOOP
08407	
08410	CF	RB=RX/71.
08500	CF	DO 81 K=0,71
08600	CF81	SLURX(K+1)=RB*(K)+R3
08700	CF	RA=R7*RST7
08775	CF41	IF(R9.EQ.0)R9=RZZ
08800	CF	R=R+RA
08900	CF	L=0
09000	CF	DO 40 K=36,1,-1
09100	CF	L=L+1
09200	CF	RW=R-RA*(K/36.)**R9
09300	CF	SLURY(L)=RW
09400	CF40	SLURY(73-L)=RW
09600	CF	L=72
09700	
09800	CF89	IF(RTILT.EQ.0)GO TO 87
10000	CF	RW=ATAN2(RTILT,RXX)
10100	CF	RA=SIN(RW)
10200	CF	RB=COS(RW)
10300	CF	RZ=SLURX(1)
10400	CF	RW=SLURY(1)
10800	CF	DO 83 K=1,L
10900	CF	R=SLURX(K)-RZ
10950	CF	RXX=SLURY(K)-RW
11000	CF	SLURX(K)=RB*R-RA*RXX+RZ
11100	CF83	SLURY(K)=RB*RXX+RA*R+RW
11200	
11300	87	IF(J4)CALL LINES(SLURX(J10),SLURY(J10),3)
11310	CC	J5=KQ
11320		J6=J10
11330		J7=L
11340		IF(J4.NE.0)GO TO 22
11350		CALL EXCH(J6,J7)
11360		J5=-1
11400	22	DO 88 K=J6,J7,J5
11500	88	CALL LINES(SLURX(K),SLURY(K),2)
11505		IF(J5.GT.1)CALL LINES(SLURX(72),SLURY(72),2)
11507	C  DISPLAY END POINT OF SLUR
11510		IF(TWICE)RETURN
11520		TWICE=TWICE-1
11522		GO TO 182
11700	180	RW=R+R7*RST7
11710		TWICE=-1
11750	CC	KQ=1
11752		J5=1
11800		RX=RX+R3
11900	CC	RA=(R5-R4)*RST7
11910		IF(J9.EQ.0)GO TO 181
11911		RZ=RTILT/(RX-R3)
11912		TWICE=2
11913	CC	RZ=RX-R3
11914		RXX=RX
11916		RWID=(R3+RXX)/2.
11992	182	IF(TWICE.EQ.1)GO TO 183
11993	C  DOES LEFT SIDE FIRST.
11994		IF(TWICE.EQ.0)GO TO 184
11995	C LAST IS NUMBER.
11996		J8=2
11999		RC=RSJT2*13.
12000		RX=RWID-RC
12010		RWW=RTILT
12012	185	RTILT=RZ*(RX-R3)
12020	
12030	C  PUT IN FUNC. HERE FOR THIS SLOPE AND FOR PART. BEAMS.
12040	
12050		GO TO 181
12060	183	J8=3
12062		RX=RXX
12066		RTILT=RWW
12068		RXX=R3
12070		R3=RWID+RC
12082		RXX=RZ*(R3-RXX)
12100		R=R+RXX
12110		RW=RW+RXX
12120		GO TO 185
12150	
12180	181	SLURX(1)=R3
12190		SLURY(1)=R
12200		SLURX(2)=R3
12300		SLURY(2)=RW
12400		SLURX(3)=RX
12500		SLURY(3)=RW+RTILT
12600		SLURX(4)=RX
12700		SLURY(4)=R+RTILT
12800		L=4
12900		IF(J8.EQ.2)L=3
13000		IF(J8.EQ.3)J10=2
13010	CC	TWICE=-1
13100		GO TO 87
13110	184	J3=RWID
13120	C  PUT IN VERT. POS. WHEN SLOPE!
13130		R4=RQQ/2.+R4+R7-1.
13135		R6=1.
13136	C  R7=1 IS FOR ITALICS
13137		R7=1
13138	C  OR USE 1 FOR ITALIC NUMBERS.
13139		R8=0
13140		CALL MAKNUM(R9)
13200		END
13600	
13700	C********  JUGGLER  ********
13800	CF	SUBROUTINE JUGGLE
13900	CF	IMPLICIT INTEGER(A-Z)
14000	CF	REAL PWDS,RN
14100	CF	COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
14200	CF    COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
14300	
14400	CF	ITEM=ITEM-1
14500	CF	JX=RN(MEDIT)+3
14600	C  WD CNT OF OLD ITEM
14700	C  I-IX IS WD CNT OF NEW ITEM
14800	CF	JY=IX
14900	CF	Z=I-IX-JX
15000	C  SPACE CHANGE
15100	CF	IF(Z)2751,172,751
15200	CF751	CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
15300	CF	JY=IX+Z
15400	CF	GO TO 172
15500	
15600	CF2751	CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
15700	
15800	CF172	J=RN(JY)+2
15900	CF	CALL LOOP(0,J,1,MEDIT,JY,RN)
16000	CF	I=IX+Z
16100	
16200	CF1751	X=ITEM+1
16300	CF	JX=WDS(X22+1)-WDS(X22)
16400	CF	J=WDS(X+1)-WDS(X)
16500	CF	Y=J-JX
16600	CF	JX=WDS(X)+Y+1
16700	CF	IF(Y)2851,182,282
16800	CF282	CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
16900	CF	GO TO 182
17000	
17101	CF2851	CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
17200	CF	JX=WDS(X)+1
17300	
17401	CF182	CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
17500	CF	DO 183 K=X22+1,X
17600	CF	PWDS(K)=PWDS(K)+Z
17700	CF183	WDS(K)=WDS(K)+Y
17800	CF	ST(2)=WDS(X)
17900	CF	X22=0
18000	CF	END
18100	
18200	
18300	CF	SUBROUTINE LOOP(I,J,K,L,M,N)
18400	CF	DIMENSION N(1)
18420	CF	MM=M-L
18500	CF	DO 1 NN=I+L,J+L,K
18600	CF1	N(NN)=N(NN+MM)
18700	CF	END
19300	
19400	
19500	CXX	SUBROUTINE PLTSRT
19600	C  SORTS DATA TO SHORTEN INVISIBLE VECTORS WHEN PLOTTING. 
19700	CF	IMPLICIT INTEGER(S-Z)
19800	CXX	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
19940	CXX	COMMON/DPY/Q(3000),P(1000),WDS(250),MEDIT,IGO
19970	C  Q AND P OCCUPY DPY BUFFER.  Q IS FOR OVERFLOW OF RN.
19985	CXX	CALL PSRT(P)
20000	CF	DO 4 K=1,ITEM
20100	CF	L=PWDS(K)
20150	CF	A=RN(L+3)
20200	CF	P(K)=A+1000*RN(L+2)
20250	CF4	IF(A.LT.0)GO TO 77
20262	CF	IF(RN(L+1).NE.16.)GO TO 177
20268	CF77CF	P(K)=-10000
20275	C  PLOTS ALL NEG. HORIZ. POSITIONS AND WORDS(CODE 16) FIRST.
20300	CF177CF	M=I
20320	CF	IF(I.LT.1500)I=1500
20340	CF	Y=I
20360	CF	I=I+M-1
20380	CF	M=Y
20400	C  M IS IN MAIN PROG., LEAVES 1500 WDS IN RN FOR "NOIR" DATA.
20500	CF2CF	A=P(1)
20600	CF	L=1
20700	CF	DO 1 K=1,ITEM
20800	CF	IF(A.LE.P(K))GO TO 1
20900	CF	A=P(K)
21000	CF	L=K
21100	CF1CF	CONTINUE
21200	CF	IF(A.EQ.10000.)RETURN
21300	C  ALL ITEMS HAVE NOW BEEN SHUFFLED
21400	CF	V=PWDS(L)
21500	CF	P(L)=10000
21600	CF	L=RN(V)+2
21700	CF	CALL LOOP(0,L,1,Y,V,RN)
21800	CF	Y=Y+L+1
21900	CF	GO TO 2
22000	CXX	END
22100	
22200	
22300	
22400		SUBROUTINE BOX(I,R,STFF)
22500	      COMMON/SIZ/RSZ,JCEN,KCEN /XRN/RN(4000) /STF/RSTFAC(-3/4),RSJ/C/L,K
22925		DIMENSION STFF(1),N(100)
22962		EQUIVALENCE (N,RN(2901))
23000		IF(I)GO TO 4
23100		K=R
23200		K=(STFF(K+4)+AMOD(RN(I+4),100.0)*7.*RSTFAC(K)
23300		1 -40.0)*RSZ-KCEN
23350	C  ↑↑↑↑ WAS -60.0 10/74
23400	C  AMOD IS FOR MINI NOTES AND CLEFS
23500		L=RHORZ(RN(I+3))*RSZ-JCEN
23600		IF(IABS(L).GT.550)L=511
23700		IF(IABS(K).GT.550)K=511
23800	CC1	CALL ALINE(L,K,L+50,K)
23900	CC	CALL RVECT(0,100)
24000	CC	CALL RVECT(-50,0)
24100	CC	CALL RVECT(0,-100)
24200	CC	L=L+25
24300	CC2	CALL ALINE(L,K-25,L,K+125)
24450	CC3	CALL DPYOUT(1)
24460		CALL SETCUR(L,K,0)
24500		RETURN
24600	4	IF(I.LT.-1)GO TO 5
24700		CALL DPYSET(3,N,100)
24800		CALL DPYBRT(3)
24900	5	L=RHORZ(R)*RSZ-JCEN
25000		IF(IABS(L).GT.550)GO TO 6
25050	C DOESN'T TRY TO DRAW LINE OFF SCREEN
25100		CALL SETPOG(3)
25200		CALL ALINE(L,-511,L,511)
25300		CALL DPYOUT(3)
25400	6	CALL SETPOG(1)
25600		END
25700	
25800	CC	SUBROUTINE LINES(A,B,L)
25850	CC	COMMON/DST/BB,CC
25900	CC	COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
26000	CC	COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
26100	CC	COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
26200	CC	COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
26400	CC	EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
26402	CC	1,(JJ2,JJ(2))
26500	CC	DATA BB/.008/,CC/3.5/
26600	C  SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
26650	CC	GO TO 23
26700	CC
26725	CC22	IF(JQ(1).NE.0)GO TO 23
26750	CC	IF(CC.EQ.1000)GO TO 23
26775	C  ABOVE TO SKIP DISTORTION ON COMMAND
26800	C  CHANGE ABOVE TO 'JFCL' IN DDT TO USE NEXT ITEMS.
27000	C  USE THIS IN DDT TO DISTORT ITEMS.  CC MUST BE > DD
27100	CC	B=B*(CC-BB*ABS(A))
27150	C  CC IS HGT FACTOR.
27200	CC23	IF(IPLT)GO TO 2
27300	CC	M=A*RSZ
27400	CC	N=B*RSZ
27500	CC	IF(RSZ.LE.0.8571)GO TO 3
27600	C NEXT FOR DISPLAY MAGNIFICATION
27700	CC	M=M-JCEN
27800	CC	N=N-KCEN
27900	CC	IF(JA.NE.8)GO TO 5
28000	C NEXT INSURES DISPLAY OF STAFF LINES
28100	CC	IF(M.GT.511)M=511
28200	CC	IF(M.LT.-511)M=-511
28400	CC5	IF(IABS(M).GT.512)GO TO 77
28450	CC	IF(IABS(N).LT.512)GO TO 4
28500	C  NOW DRAWS INVISIBLE VECT. IF IT GOES OFF THE SCREEN.
28600	CC77	KZ=-1
28700	CC	RETURN
28800	CC4	IF(KZ.EQ.0)GO TO 6
28900	CC	KZ=0
29000	CC	GO TO 1
29050	CC3	IF(JA.EQ.44)GO TO 6
29075	C JA=44=BAR LINES - THEY DON'T FIGURE IN MAX. HGT.
29100	CC	K=B
29200	CC	IF(K.GT.ITOP)ITOP=B
29300	CC	IF(K.LT.IBOT)IBOT=B
29302	CC6	IF(JJ2.GT.3990)RETURN
29400	CC	IF(L.EQ.3)GO TO 1
29500	CC	CALL AVECT(M,N)
29600	CC	RETURN
29700	CC1	CALL AIVECT(M,N)
29800	CC	RETURN
29900	CC2	IF(IPLT.EQ.-2)RETURN
30300	C RXGP SETS UP-DOWN POS. ON XEROX PAPER (FRACTIONAL POSITIONS POSSIBLE.)
31110	CC9	M=ROFF(A*DIS)
31120	CC	N=ROFF(B*RHT)
31200	CC8	CALL PLOT(M,N,L)
31400	CC	END
31540	
35100	C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
35200	CF	SUBROUTINE HOMER
35300	CF	IMPLICIT INTEGER(A-Q,S-Z)
35400	CF	REAL PWDS,DISX,A,B,PLACE,STFF
35500	CF	COMMON /STF/RSTFAC(-3/4),RSTJ2
35600	CF    COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
35700	CF	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
35800	CF	COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
35900	CF	EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(4000))
36000	CF	1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
36100	CF	1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
36200	CF	IF(JA.EQ.6)GO TO 9
36300	CF	IF(R13.NE.0)GO TO 10
36400	C  FOR GENL HOMING; WORDS;  BEAMS;  STEMS;
36500	
36600	CF	IF(JQ(1).EQ.0)GO TO 197
36700	C  TO HOME IN ON NOTE ON DIFFERENT STAFF.
36800	CF	JJ2=R2
36900	CF	K=PWDS(JJ2)
37000	CF	L=PWDS(JQ(1))
37100	CF	RA=RN(K+3)
37200	CF	RB=RN(L+3)
37300	C  RB=POS OF NOTE,  RA=POS(P3) OF BEAM
37400	CF	N=0
37500	CF	IF(RN(L+5).LT.20)N=-1
37600	C  -1 MEANS STEM IS UP
37700	CF	RG=-(AMOD(RN(K+7),10.)-1.)*11./7.
37800	C   SPACE FOR THE NUMB. OF BEAMS
37900	CF	J11=RN(L+2)
38000	CF	M=0
38100	CF	IF(RN(K+7).LT.20.)M=-1
38200	CF	X=RN(K+2)
38300	C  THE STAFF NUMS.  X=BEAM   J11=NOTE
38400	CF	R3=RSTFAC(X)
38500	CF	R9=RSTFAC(J11)/R3
38600	CF	R8=R3*14.54/5.96
38700	C  R8=WIDTH OF NOTE
38800	C******* 5/74  BOTH STAVES MUST BE SAME SIZE - MOST LIKELY ********
38900	CF	R7=96./7.
39000	C  MUST BE DOUBLE STEM LENGTH
39100	CF	RD=RN(L+8)
39200	CCCF	IF(RD.EQ.999)RD=0
39300	C  THE STEM LENGTH
39900	CF3	IF(M.NE.N)GO TO 5
40000	CF	R8=0
40100	CF	R7=0
40200	CF	RG=0
40300	CF	GO TO 4
40400	CF5	IF(M.EQ.0)GO TO 4
40500	CF	R7=-R7
40600	CF	R8=-R8
40700	CF	RD=-RD
40800	CF	RG=-RG
40900	
41000	C  NOT OK IF DIFF SIZES AND RA.GT.RB ****** 5/74
41100	CF4	RN(K+6)=RB+R8
41200	C  SETS CORRECT HORIZANTAL PARAM OF BEAM.
41300	CF	RF=7.*R9
41400	CF	RE=(STFF(J11)-STFF(X))/RF
41500	C  DIST BETWEEN STAVES.
41600	CF	RN(K+5)=RN(L+4)+RE+(R7+RD+RG)*R9
41700	CF	RETURN
41800	
41900	C*********************************************************
42000	C  NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
42100	CF197	JJ2=-1
42200	
42300	CF	R3=R2
42400	CF	DO 191 K=1,ITEM
42500	CF	L=PWDS(K)
42600	CF	IF(RN(L+1).NE.6)GO TO 191
42650	CF	IF(RN(L+2).EQ.R3)GO TO 77
42675	CF	IF(R3.LT.5.)GO TO 191
42700	C   TYPE 19 99 FOR ALL STAVES
42800	CF77	RG=RN(L+7)
42900	CF	IF(RN(L).EQ.8)GO TO 191
42950	CF	IF(RG.LT.10.)GO TO 191
43000	C  FINDS BEAMS.
43100	CF	A=RN(L+3)-.01
43200	CF	B=RN(L+6)+.01
43300	C  POS 1 AND 2
43400	CF	DISX=B-A
43500	C  DISTANCE IN REAL STEPS
43600	CF	RB=AMOD(RN(L+5),100.0)
43700	C  NOTE 2
43800	CF	RF=AMOD(RN(L+4),100.0)
43900	CF	RD=RB-RF
44000	C  HEIGHT
44100	CF	R2=RN(L+2)
44200	C  ↑↑↑ USED IN 'FINDIT'
44300	CF	X=RG/10.
44400	C  STEM DIRECT.
44500	
44600	CF	DO 192CF	N=1,ITEM
44800	CF	IF(FINDIT(N))GO TO 192
44900	CF	IF(RN(L).EQ.8)GO TO 192
44950	CF	IF(RN(L+8).EQ.1000.)GO TO 192
45000	C SKIPS SLASHED GRACE NOTES (P8=1000 OR P10=1)
45100	C  FINDIT IS NEG. IF(RN(L+1).NE.1.OR.RN(L+3))
45200	CF	RC=RN(L+3)
45300	CF	IF(RC.LT.A)GO TO 192
45350	CF	IF(RC.GT.B)GO TO 192
45400	C  WHAT'S LEFT IS IN BEAM AREA IF STEM DIR. IS OK.
45500	CF	IF(X.NE.IFIX(RN(L+5)/10.))GO TO 192
45600	CF	RC=RC-A
45700	CF193	RE=AMOD(RN(L+4),100.0)
45800	CF	RC=RD*RC/DISX+RF
45900	CF	RG=RN(L+7)
46000	CF	RN(L+7)=RG-AMOD(RG,10.0)+AMOD(RG,1.0)
46100	C   DELETES TAILS WITHOUT REMOVING DOTS OR SPACING OF DOTS.
46200	C  FRACTIONAL NOTE #
46300	CF195	RA=RC-RE
46400	CF	IF(X.EQ.2)RA=-RA
46500	CF	IF(RA.EQ.0)RA=999.
46600	CF196	RN(L+8)=RA
46700	C  FRACTIONAL NOTE # - FIRST NOTE OF GROUP + THIS NOTE # ALL *7.
46800	CF	IF(JJ2)JJ2=N
46900	C  SAVES # OF FIRST ITEM FOUND
47000	CF192	CONTINUE
47100	CF191	CONTINUE
47200	CF	RETURN
47300	
47400	C*********************************************************
47500	CF9	IF(J11.LT.0)RETURN
47600	C   IF P11=-1 NO HOMING
47700	CF	X=R7/10.
47750	CF	IF(X)X=-X
47800	C  X IS STEM DIRECTION
47900	CF	RA=R9
48000	C  R9= POS3
48100	CF	RC=-1.
48200	CF	IF(R9.NE.0)RC=-2.
48300	CF	IF(J10/10.EQ.3)RC=-3
48400	C  RC=1 ESCAPES FROM LOOP.
48500	C   HOMING RANGE FOR BEAMS
48600	CF10	IF(R11.EQ.0)R11=2.9
48700	C   IF P11.NE.0 RANGE IS CHANGED FROM 2
48800	CF	IF(JA.EQ.5)RC=-1
48850	C******↑↑↑↑↑↑↑ WAS 8????
48900	CF	DO 361 K=1,ITEM
49000	CF	IF(FINDIT(K))GO TO 361
49100	C  SKIPS NOTES ON WRONG LINE 
49200	CF	RD=RN(L+3)
49300	CF1	IF(JA.NE.6)GO TO 177
49350	CF	IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
49400	CF177	IF(PLACE(R3))GO TO 461
49500	CF	R3=RD
49600	C  LOOKS FOR NOTE, STAFF #, STEM DIR.
49700	CF	IF(JA.EQ.6)GO TO 861
49750	CF	IF(JA.EQ.5)GO TO 261
49800	CF	RETURN
49900	
50000	CF461	IF(JA.EQ.6)GO TO 277
50050	CF	IF(JA.NE.5)GO TO 361
50100	CF277	IF(PLACE(R6))GO TO 561
50200	CF	R6=RD
50350	CF861	IF(J7.GE.0)GO TO 261
50400	CF561	IF(PLACE(RA))GO TO 661
50450	CF	IF(J7)GO TO 761
50462	C  J7=NEG MEANS TREMOLO
50475	CF	IF(R8.EQ.0)GO TO 361
50500	CF761	R9=RD
50550	C  R8=0 MEANS R9 IS NUMBER OUTSIDE OF BEAM.
50600	CF	GO TO 261
50700	CF661	IF(JA.EQ.5)GO TO 361
50750	CF	IF(J10.LT.30)GO TO 361
50800	CF	IF(PLACE(R8))GO TO 361
50900	C  HOMES INNER PARTIAL BEAMS
51000	CF	R8=RD
51100	CF261	RC=RC+1
51200	CF	IF(RC.EQ.1.)RETURN
51300	CF361	CONTINUE
51400	CF	END
51500	
51600	CF	FUNCTION PLACE(X)
51700	CF	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
51800	CF	EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
51900	CF	PLACE=R11-ABS(RD-X)
52000	CF	END
52100	
52200	CF	FUNCTION FINDIT(N)
52300	CF	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
52400	CF	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
52500	CF	FINDIT=0
52600	CF	L=PWDS(N)
52700	CF	IF(RN(L+1).NE.1)GO TO 377
52750	CF	IF(RN(L+2).EQ.R2)RETURN
52775	CF377	FINDIT=-1
52800	CF	END
52900	
53000		SUBROUTINE SCL
53100	C  SETS UP SCALING MARKERS.
53200		DIMENSION SU(400)
53300		COMMON /STF/RSTFAC(-3/4),RSTJ2 /XRN/RN(4000)
53400		COMMON R2,JA,CT,J2,R3,R4,R5,RJQ(17),J3,J4,J5,J6,J(16)
53500		1 /POSI/STFF(-3/4),J102,POS
53600		EQUIVALENCE (SU(400),RN(3001))
53700		J2=R2
53800		IF(J2.NE.99)GO TO 1008
53900		CALL HYDPOG(2)
54000		RETURN
54100	1008	J5=0
54200		J6=0
54300		RSTJ2=RSTFAC(J2)
54400	C  SETS UP SCALE LINES.
54500		J4=200
54600		IF(R3.NE.0)J4=400
54700	C  PUTS SCALE TO 400
54800		R2=STFF(J2)+60.*RSTJ2
54900		RJ=R2+60.
55000		CALL DPYSET(2,SU,700)
55100		CALL DPYBRT(1)
55200		POS=RJ+40.
55300		RSTJ2=1.
55400		DO 1002 MX=10,J4,10
55500		RA=RHORZ(FLOAT(MX))
55600		R3=RA-58
55700		IF(MX.GT.10)CALL PNUM
55800	CC1005	IF(R5.NE.0)GO TO 1007
55900	C  JUMP FOR STAFF NUMBERS
56000		CALL LINX(RA,R2,RA,RJ)
56100		J5=J5+1
56200	1002	IF(J5.EQ.10)J5=0
56300		CALL LINES(-596.0,RJ,2)
56400		CALL LINES(-596.0,R2,2)
56500		R6=1.5
56600	C  NEXT SETS UP STAFF NUMBERS
56700		R3=-620.
56800		DO 1007 K=-3,4
56900		POS=STFF(K)+40.
57000		J5=IABS(K)
57100		CALL PNUM
57200	1007	CONTINUE
57300		CALL DPYOUT(2)
57400		CALL SETPOG(1)
57450		END
57475	
57500	C  NEXT ALLOWS YOU TO TYPE 'SA NAME' OR 'SAVE NAME' ETC.
57600	C  (NO MORE THAN 9 CHARS. MAY COME BEFORE NAME)
57700		SUBROUTINE FORMAT(NAME)
57750	C  SO WE CAN TYPE 'SA NAME' OR 'SAVE    NAME', ETC.
57800		COMMON /ALF/INP(72),ML 
57900		DIMENSION DMY(50),IFMT(2)
58000		EQUIVALENCE (INP(20),DMY)
58100		DATA IFMT(2)/' ,A5)'/
58200	
58300		DO 1 K=2,72
58400		IF(INP(K).NE.' ')GO TO 1
58500		DO 2 L=K+1,72
58600		IF(INP(L).EQ.' ')GO TO 2
58700	C NOW WE START NAME
58800		L=L-1
58900	5	IFMT(1)='( 0A1'+L*32768
59000	C  32768 IS MAGIC NUM TO CHANGE '0' TO RIGHT NUM.
59100		REREAD IFMT,(DMY(K),K=1,L),NAME
59200		RETURN
59300	2	CONTINUE
59400		NAME=' '
59500		RETURN
59600	1	CONTINUE
59700		END